perm filename D1[AM,DBL] blob
sn#211585 filedate 1976-04-16 generic text, type T, neo UTF8
(FILECREATED "13-APR-76 18:24:09" <LENAT>D1.;7 18799
changes to: DO-THRESH INTHRESH D1COMS
previous date: "13-APR-76 01:12:10" <LENAT>D1.;6)
(LISPXPRINT (QUOTE D1COMS)
T T)
[RPAQQ D1COMS ((FNS HANDLE-CANON BLOWUP-RESTRIC ABC2)
GCNT CANDS DO-THRESH INTHRESH D1CONS (COMS * (LIST (CONS (QUOTE IFPROP)
(CONS (QUOTE ALL)
D1CONS]
(DEFINEQ
(HANDLE-CANON
[LAMBDA (BA1 BA2 BA3)
[COND
((NOT (AND (ISA BA1 (QUOTE PREDICATE))
(ISA BA2 (QUOTE PREDICATE))
(NEQ BA1 BA2)))
(SETQ GTEMP12 NIL))
((IS-CON (SETQ GTEMP12 (GLUE-CANO BA1 BA2))) (* Note that we are assuming that there
will not be more than 1 canonization for
any given pair of predicates)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE CANONIZE))
CS-B)
(T (QUOTE CANONIZE]
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
([SETQ GTEMP11 (SOME [SETQ GTEMP200 (NCONC (MAPCAR (EXS-BDY CANONIZE)
(QUOTE LASTELE))
(MAPCAR (EXS CANONIZE)
(QUOTE LASTELE]
(FUNCTION (LAMBDA (Z)
(SOME (GETB Z (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'APPLICATION 'OF & ('APPLYB ('QUOTE 'CANONIZE)
('QUOTE 'ALGS)
('QUOTE =BA1)
('QUOTE =BA2)
$]
(SETQ GTEMP12 (CAR GTEMP11)))
((SETQ GTEMP11 (DEDUCE-CANON BA1 BA2 GTEMP12 [SETQ GTEMPA (CAR (ANY1OFE (GETB BA1 (QUOTE D-R]
(CONTRAST-DEFNS BA1 BA2)))
(GS-CHECK GTEMP12)
(CPRIN1 (COND
((MATCH CS-ACT WITH ('APPLYB ('QUOTE 'CANONIZE)
$))
7)
(T 98))
CRLF Succeeded EXCLAIM CRLF)
(* Here we must boost or do the following: (1) Create a new specialization of GTEMPA =
(Car (any1ofe (getb BA1 D-R))) called Canonical-A, which contains just those A's which are
Gtemp12-canonical, with all the GTEMPA defns suitably transformed;
and (2) create new specializations of BA1 and BA2, called Canon-restric-BA1 and -BA2, which have the
same defns as BA1 and BA2 but are restricted to the domain Canonical-A x Canonical-A;
(3) with much less interest level, consider all things in the IN-DOM-OF part of A, and consider
restricting those operations to Canonical-A; (4) with even less intensity, consider how those ops in
IN-RAN-OF (GTEMPA) might be restricted so as to only map into Canonical-A;
some of these are true for ANY new specialization of a Being GTEMPA)
(SETBQ CANONIZE GWORTH (APPEND (GETBQ CANONIZE WORTH)))
(RPLACA (GETB (QUOTE CANONIZE)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE CANONIZE)
(QUOTE WORTH)))
3 2))
(BLOWUP-CANR GTEMPA GTEMP12 BA1 BA2) (* This binds Newb to the name of the
new canonical class of GTEMPA)
(BOOST1 (IDIFFERENCE CS-INT 2)
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE BA1)
(KWOTE NEWB)
(Q DOMAIN))
(SPLIST BA1 was one
of the predicates which defined the new concept NEWB COMMA so it is worth considering the
restriction
of BA1
to that subset of GTEMPA APOS))
(CPRIN1S 6 CRLF Some conjectures that AM considers believable COLON CRLF CRLF BA2 COMMA restricted
to canonical GTEMPA APOS COMMA is indistinguishable
from BA1 DCR CRLF There is a powerful analogy between CRLF)
(COND
((IGREATERP VERBOSITY 6)
(TERPRI)
(PAD BA1 33 BA2)
(PAD GTEMPA 33 NEWB)
(PAD "operators on and into" 33 "those operators restricted to")
(PADI GTEMPA 33 NEWB)
(PAD "statements involving these" 33 "statements involving these")
(TERPRI)))
[INCRB BA1 (QUOTE ANAS)
(LIST BA2 (LIST BA1 BA2)
(LIST GTEMPA NEWB)
(LIST (QUOTE ANY-OPERATION)
(LIST (QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(Q ANY-OPERATION)
(KWOTE NEWB]
[MAPC (OR (GETB GTEMPA (QUOTE IN-DOM-OF))
(APPLY* (QUOTE IN-DOM-OF)
GTEMPA))
(FUNCTION (LAMBDA (ID)
(BOOST1 (SMALLER (DOTPROD (NCONC (LIST CS-INT DO-THRESH INTHRESH)
(GETB ID (QUOTE WORTH)))
(LIST .5 .1 .1 .1 .1 .1))
(IDIFFERENCE CS-INT 5))
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE ID)
(KWOTE NEWB)
(Q DOMAIN))
(SPLIST ID operates on the space GTEMPA COMMA for which we now have a canonical
representation]
(AND [SETQ ID (CAR (GETB GTEMPA (QUOTE IN-DOM-OF]
(BOOST1 CS-INT (QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE ID)
(KWOTE NEWB)
(Q DOMAIN))
(SPLIST ID operates on the space GTEMPA COMMA for which we now have a canonical representation)))
[MAPC (GETB GTEMPA (QUOTE IN-RAN-OF))
(FUNCTION (LAMBDA (ID)
(BOOST1 (SMALLER (DOTPROD (NCONC (LIST CS-INT DO-THRESH INTHRESH)
(GETB ID (QUOTE WORTH)))
(LIST .3 .1 .1 .1 .1 .1))
(IDIFFERENCE CS-INT 8))
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE ID)
(KWOTE NEWB)
(Q RANGE))
(SPLIST ID maps into the space GTEMPA COMMA for which we now have a canonical representation]
(* Note that those ops whose dom and ran
are both GtempA will be highly
reinforced)
NEWB)
(T (KILB GTEMP12)
(CPRIN1 (COND
((MATCH CS-ACT WITH ('APPLYB ('QUOTE 'CANONIZE)
$))
6)
(T 97))
CRLF Failed DCR) (* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE CANONIZE)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE CANONIZE)
(QUOTE WORTH)))
2 3]
(COND
((AND BA3 (IS-CON GTEMP12))
(APPLYB GTEMP12 (QUOTE ALGS)
BA3))
((IS-CON GTEMP12])
(BLOWUP-RESTRIC
[LAMBDA (BA1 BA2 BA3)
(COND
([NOT (AND (ISA BA1 (QUOTE ACTIVE))
(OR (ISA BA2 (QUOTE ANY-STRUC))
(ISAG BA2 (QUOTE OBJECT)))
(COND
((NULL BA3)
(DEDUCE-RPART BA1 BA2))
((ISA BA3 (QUOTE ACTIVE)) (* Then all we must do is confirm or
deny that BA3 is the desired
restriction)
(SETQ GTEMP12 (CHECK-RES BA1 BA2 BA3)))
((FMEMB BA3 POSS-RPARTS) (* Then we must find the restriction,
but we have been told what part of the
BA1 operation is to be modified)
(SETQ GRPART BA3)
(SETQ BA3 NIL)
(CONFIRM-RPART BA1 BA2 GRPART))
(T (* I will assume that this is an
erroroneous instantiation of BA3)
(CPRIN1S 0 CRLF Erroneous instantiation of (QUOTE BA3) as BA3 in Restrict DCR CRLF)
(SETQ BA3 NIL)
(DEDUCE-RPART BA1 BA2] (* Checking the arguments: a function, a
structure, the restriction of that
function function to that structure
(if unspecified, this is what we
compute))
NIL)
([IS-CON (SETQ GTEMP12 (GLUE-IF-ABLE BA1 BA2 (QUOTE RESTRICT-)
(QUOTE RES-] (* Note that we are assuming that there
will not be more than 1 restriction for
any given pair of operation and
structure)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE RESTRICT))
CS-B)
(T (QUOTE RESTRICT]
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
([SETQ GTEMP11 (SOME [SETQ GTEMP200 (NCONC (MAPCAR (EXS-BDY RESTRICT)
(QUOTE LASTELE))
(MAPCAR (EXS RESTRICT)
(QUOTE LASTELE]
(FUNCTION (LAMBDA (Z)
(SOME (GETB Z (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'APPLICATION 'OF & ('APPLYB ('QUOTE 'RESTRICT)
('QUOTE 'ALGS)
('QUOTE =BA1)
('QUOTE =BA2)
$]
(SETQ GTEMP12 (CAR GTEMP11)))
((AND GRPART GRCOMP GTEMP12)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE RESTRICT))
CS-B)
(T (QUOTE RESTRICT]
(CREATEB GTEMP12)
(INCRB GTEMP12 (QUOTE GENL)
BA1)
(INCRB BA1 (QUOTE SPEC)
GTEMP12)
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB GUP1 (QUOTE EXS)
(LIST BA1 BA2 GTEMP12))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE EAVG2)))
(GS-CHECK GTEMP12)
[INCRB GTEMP12 (QUOTE D-R)
(APPEND (ANY1OFE (GETB BA1 (QUOTE D-R]
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE REDUCING-TO)
BA1
(LIST (QUOTE AND)
(QUOTE NEW-CONDS)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q DEFN))
(GARGS2 BA1]
[INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE SLOW)
(LIST (QUOTE AND)
(LIST (QUOTE SETQ)
(QUOTE BA5)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q ALGS))
(GARGS BA1)))
(QUOTE NEW-CONDS)
(QUOTE BA5]
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE RESTRICT))
(INCRB BA2 (QUOTE IN-DOM-OF)
(QUOTE RESTRICT))
[SETQ GTEMP386 (CAR (LAST (GARGS2 BA1]
(COND
[[OR (EQ GRPART (QUOTE RANGE))
(AND (EQ GRPART (QUOTE DOMAIN))
(EQ GRCOMP (LASTELE (ANY1OFE (GETB GTEMP12 (QUOTE D-R]
(DSUBST BA2 GRCOMP (GETB GTEMP12 (QUOTE D-R)))
(DSUBST (LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE BA2)
(QUOTE BA5))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE ALGS)))
(DSUBST (LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE BA2)
GTEMP386)
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE DEFN]
[(EQ GRPART (QUOTE DOMAIN))
(DSUBST BA2 GRCOMP (GETB GTEMP12 (QUOTE D-R)))
(DSUBST (LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA2))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE ALGS)))
(DSUBST (LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA2))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE DEFN]
((EQ GRPART (QUOTE DEFN)) (* I am unsure how to do this;
wait for specific needs and then fill
this in)
(NOTINYET))
(T (CPRIN1S 7 Unusual Grpart COLON GRPART in Restrict DCR)))
(CPRIN1 9 CRLF Succeeded EXCLAIM CRLF)
(BOOST1 (CINT (CADR CANDS))
(QUOTE FILLIN)
GTEMP12
(QUOTE EXS)
NIL
(SPLIST There was a good reason for creating this restriction, so (QUOTE AM)
should at least look at it a little))
GTEMP12)
(T (KILB GTEMP12)
(CPRIN1 6 CRLF Failed DCR) (* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE RESTRICT)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE RESTRICT)
(QUOTE WORTH)))
2 3])
(ABC2
[LAMBDA NIL
[SETQ GNEKNT (IPLUS GNEKNT (IDIFFERENCE (LENGTH (GETB CS-B (QUOTE EXS)))
(LENGTH (SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(SET-DIFFERENCE
(SELF-INT (GETB CS-B (QUOTE EXS)))
(NCONC (MAPCONC (GETB CS-B (QUOTE SPEC))
(QUOTE ACEX-COPY))
(GETB CS-B (QUOTE EXS-BDY]
(* (COND ((GETB CS-B (QUOTE EXS)) (BOOST1 (AVG2 CS-INT
(CAR (GETB CS-B (QUOTE WORTH)))) (QUOTE FILLIN) CS-B
(QUOTE TIES) NIL (SPLIST Examples of CS-B remain after checking COMMA to compare against other
concepts))) (T (CPRIN1S 9 Won't bother looking for ties to CS-B DCR)
(SWHY 9 CS-B has no examples that withstood checking DCR))))
NIL])
)
(RPAQQ GCNT 9)
[RPAQQ CANDS
(((FILLIN OBJ-EQUAL EXS)
600
((Some example sets are interesting because all pairs of members satisfy OBJ-EQUAL)
(Anyb-exs specifically asked for some examples of OBJ-EQUAL ", " while trying to "Fill in some"
"conjectures involving the concept" Bag-struc)
(We have no examples for OBJ-EQUAL yet)))
((FILLIN COMPOSE EXS)
200
((Anyb-exs specifically asked for some examples of COMPOSE ", " while trying to "Fill in some" Bag-struc
"conjectures involving the concept")
(We have no examples for COMPOSE yet)))
((FILLIN EMPTY-STRUC EXS)
200
((We have no examples for EMPTY-STRUC yet)
(Anyb-exs specifically asked for some examples of EMPTY-STRUC ", " while trying to "Fill in some" Bag-struc
"conjectures involving the concept")))
((FILLIN COALESCE EXS)
150
((Anyb-exs specifically asked for some examples of COALESCE ", " while trying to "Fill in some" Bag-struc
"conjectures involving the concept")
(We have no examples for COALESCE yet)))
((FILLIN ORD-PAIR EXS)
145
((We have no examples for ORD-PAIR yet)
(Anyb-exs specifically asked for some examples of ORD-PAIR ", " while trying to "Fill in some" Bag-struc
"conjectures involving the concept")))
((FILLIN OSET-STRUC EXS)
145
((We have no examples for OSET-STRUC yet)
(Anyb-exs specifically asked for some examples of OSET-STRUC ", " while trying to "Fill in some" Bag-struc
"conjectures involving the concept")))
((FILLIN REV-ORD-PAIR EXS)
140
((Anyb-exs specifically asked for some examples of REV-ORD-PAIR ", " while trying to "Fill in some"
Bag-struc "conjectures involving the concept")
(We have no examples for REV-ORD-PAIR yet)))
((CHECK SET-OF-LISTS EXS)
100
((Some examples of SET-STRUC turned out to be examples of SET-OF-LISTS as well ; They may check out to be
examples of specializations of SET-OF-LISTS]
(RPAQQ DO-THRESH 199)
(RPAQQ INTHRESH 66)
(RPAQQ D1CONS (LIST-STRUC SET-STRUC BAG-STRUC))
(PUTPROPS LIST-STRUC GENL (ORD-OBJ MULT-STRUC)
WORTH (300 200 700 500 400 990 900 1000 800 800 1000)
DEFN [(TYPE NONRECURSIVE (AND (LISTP BA1)
(EQ (CAR BA1)
(QUOTE VECTOR]
INTU [(CONS (QUOTE VECTOR)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE VECTOR)
(APPEND (SETQ RB1 (RAND-SUBSET USERNAMES))
(RAND-SUBSET RB1)))
(CONS (QUOTE VECTOR)
(RAND-PERMUTE (RAND-SUBSET USERNAMES]
IN-DOM-OF (LIST-STRUC-INSERT FIRST REAR FINAL LIST-STRUC-DELETE LIST-STRUC-INTERSECT)
EXS ((VECTOR A)
(VECTOR B)
(VECTOR A B)
(VECTOR A A)
(VECTOR B A)
(VECTOR A A B)
(VECTOR D M I F O)
(VECTOR B (BAG B)
(CLASS)
A)
(VECTOR O D F I M)
(VECTOR A B (VECTOR B)
(CLASS))
(VECTOR CORDELL DON)
(VECTOR R2-0 R2-1)
(VECTOR A A A)
(VECTOR B B B)
(VECTOR A B C)
(VECTOR A B B)
(VECTOR C)
(VECTOR C C)
(VECTOR C C C C)
(VECTOR A A B C)
(VECTOR A A A C))
EXS-BDY ((VECTOR)
(VECTOR BAG))
EXS-NOT-BDY ((BAG VECTOR)
(CLASS))
IN-RAN-OF (LIST-STRUC-DELETE LIST-STRUC-INSERT LIST-STRUC-INTERSECT)
UP (ANY-STRUC)
FEX (4 (VECTOR)
(VECTOR A)
(VECTOR B)
(VECTOR A B)
(VECTOR A A)
(VECTOR B A)
(VECTOR A A B)
(VECTOR D M I F 0)
(VECTOR B (BAG B)
(CLASS)
A)
(VECTOR)
(VECTOR BAG)))
(PUTPROPS SET-STRUC GENL (UNORD-OBJ NONMULT-STRUC)
WORTH (750 700 700 500 400 990 900 1000 800 800 1000)
DEFN [[TYPE NONRECURSIVE (AND (LISTP BA1)
(EQ (CAR BA1)
(QUOTE CLASS]
(TYPE RECURSIVE (COND [(EQUAL BA1 (LIST (QUOTE CLASS]
((NOT (AND (LISTP BA1)
(CDR BA1)))
NIL)
((APPLYB (QUOTE SET-STRUC)
(QUOTE DEFN)
(APPLYB (QUOTE STRUCTURE-DELETE)
(QUOTE ALGS)
(APPLYB (QUOTE STRUCTURE-MEMB)
(QUOTE ALGS)
NIL
(COPY BA1))
(COPY BA1]
INTU [(CONS (QUOTE CLASS)
(RAND-SUBSET USERNAMES))
(CONS (QUOTE CLASS)
(RECTANGLE (RAND 0 7)
(RAND 0 7)
(RAND 0 7)
(RAND 0 7]
IN-DOM-OF (SET-STRUC-INSERT SET-STRUC-DELETE SET-STRUC-DIFF SET-STRUC-INTERSECT)
IN-RAN-OF (SET-STRUC-DELETE SET-STRUC-DIFF SET-STRUC-INSERT SET-STRUC-INTERSECT)
SPEC (SET-OF-LISTS SET-OF-STRUCS)
UP (ANY-STRUC)
FEX (8 (CLASS CORDELL DON)
(CLASS R2-0 R2-1)
(CLASS A)
(CLASS B)
(CLASS A B)
(CLASS 0 D F I M)
(CLASS A B (BAG B)
(CLASS))
(CLASS))
UP-NOT (ACTIVE PREDICATE)
EXS ((CLASS CORDELL DON)
(CLASS R2-0 R2-1)
(CLASS A)
(CLASS B)
(CLASS A B)
(CLASS 0 D F I M)
(CLASS A B (BAG B)
(CLASS))))
(PUTPROPS BAG-STRUC GENL (UNORD-OBJ MULT-STRUC)
WORTH (600 700)
DEFN [(TYPE NONRECURSIVE (AND (LISTP BA1)
(EQ (CAR BA1)
(QUOTE BAG]
IN-DOM-OF (BAG-STRUC-JOIN BAG-STRUC-INTERSECT BAG-STRUC-INSERT BAG-STRUC-DELETE)
IN-RAN-OF (BAG-STRUC-JOIN BAG-STRUC-INTERSECT BAG-STRUC-INSERT BAG-STRUC-DELETE)
SPEC (BAG-OF-STRUCS)
UP (ANY-STRUC)
FEX (4)
UP-NOT (ACTIVE)
EXS-NOT-BDY ((CLASS)
(CLASS CORDELL DON)
(CLASS R2-0 R2-1)
(CLASS A)
(CLASS B)
(CLASS 0 D F I M)
(VECTOR A)
(VECTOR B)
(VECTOR A B)
(VECTOR B A)
(VECTOR D M I F 0)
(VECTOR BAG))
EXS ((BAG A)
(BAG B)
(BAG A B)
(BAG A A)
(BAG A A B)
(BAG O D F I M)
(BAG A B (BAG B)
(CLASS))
(BAG CORDELL DON)
(BAG R2-0 R2-1)
(BAG A A A)
(BAG B B B)
(BAG A B C)
(BAG A B B)
(BAG)
(BAG C)
(BAG C C)
(BAG C C C C)
(BAG A A B C)
(BAG A A A C)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (390 11980 (HANDLE-CANON 402 . 5974) (BLOWUP-RESTRIC 5978 . 11229) (ABC2 11233 . 11977)))))
STOP